home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / utils / tngsd100.zip / SD2RD.PAS < prev   
Pascal/Delphi Source File  |  1996-04-11  |  3KB  |  134 lines
  1. {$N-,E- no math support needed}
  2. {$X- function calls may not be discarded}
  3. {$I- disable I/O checking (trap errors by checking IOResult)}
  4.  
  5. PROGRAM real_date_maker;
  6. USES NumDays;
  7.  
  8. PROCEDURE showhelp (errornum : BYTE);
  9. VAR
  10.   message : STRING [60];
  11. BEGIN
  12.   WriteLn;
  13.   WriteLn ('  Usage :  SD2RD star date');
  14.   WriteLn;
  15.   WriteLn ('Example :  SD2RD 41153.7');
  16.   WriteLn;
  17.   IF errornum > 0 THEN BEGIN
  18.     CASE errornum OF
  19.       0 : message := '';
  20.       ELSE  message := 'Unanticipated error of unknown type.';
  21.     END;
  22.     WriteLn;
  23.     WriteLn ('ERROR: (#', errornum, ') - ', message);
  24.   END;
  25.   Halt (errornum);
  26. END;
  27.  
  28. FUNCTION lz (w : WORD) : STRING;
  29. VAR
  30.   s : STRING;
  31. BEGIN
  32.   Str (w: 0, s);
  33.   IF Length (s) = 1 THEN
  34.     s := '0' + s;
  35.   lz := s;
  36. END;
  37.  
  38. PROCEDURE sMonths (Year: INTEGER; VAR Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec : WORD; VAR HoursInYear:REAL);
  39. BEGIN
  40.   HoursInYear := 8760;
  41.  
  42.   Jan := 31*24;
  43.   Feb := 28*24 + Jan;
  44.  
  45.   IF IsLeapYear (Year) THEN
  46.   BEGIN
  47.     HoursInYear := HoursInYear + 24;
  48.     Inc (Feb, 24);
  49.   END;
  50.  
  51.   Mar := 31*24 + Feb;
  52.   Apr := 30*24 + Mar;
  53.   May := 31*24 + Apr;
  54.   Jun := 30*24 + May;
  55.   Jul := 31*24 + Jun;
  56.   Aug := 31*24 + Jul;
  57.   Sep := 30*24 + Aug;
  58.   Oct := 31*24 + Sep;
  59.   Nov := 30*24 + Oct;
  60.   Dec := 31*24 + Nov;
  61. END;
  62.  
  63. PROCEDURE ConvertDate (mStr: STRING; VAR Month: STRING; VAR Day, Hours: REAL; Days: WORD);
  64. BEGIN
  65.   Month := mStr;
  66.   Day := Trunc (1 + ((Hours - Days) / 24));
  67.   Hours := 24 + Hours - ((Day * 24) + Days);
  68. END;
  69.  
  70. VAR
  71.   stardate,
  72.   Hours,
  73.   HoursInYear : REAL;
  74.  
  75.   Month : STRING;
  76.  
  77.   Day  : REAL;
  78.   Year : INTEGER;
  79.   Minutes : REAL;
  80.   Min : WORD;
  81.  
  82.   Jan, Feb, Mar,
  83.   Apr, May, Jun,
  84.   Jul, Aug, Sep,
  85.   Oct, Nov, Dec : WORD;
  86.  
  87.   vErr : INTEGER;
  88.  
  89. BEGIN
  90.   WriteLn ('SD2RD v1.00 - Free DOS tool: star date to real date convertor.');
  91.   WriteLn ('April 11, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware.');
  92.  
  93.   IF (ParamCount = 0) THEN ShowHelp (0);
  94.  
  95.   Val (ParamStr (1), stardate, vErr);
  96.   Year := 2323 + Trunc (stardate / 1000);
  97.  
  98.   sMonths (Year, Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec, HoursInYear);
  99.  
  100.   stardate := stardate - 1000 * (Trunc (stardate / 1000));
  101.   Hours := stardate * HoursInYear / 1000;
  102.  
  103.   IF (Hours > Nov) THEN
  104.     ConvertDate ('December', Month, Day, Hours, Nov) ELSE
  105.   IF (Hours > Oct) THEN
  106.     ConvertDate ('November', Month, Day, Hours, Oct) ELSE
  107.   IF (Hours > Sep) THEN
  108.     ConvertDate ('October', Month, Day, Hours, Sep) ELSE
  109.   IF (Hours > Aug) THEN
  110.     ConvertDate ('September', Month, Day, Hours, Aug) ELSE
  111.   IF (Hours > Jul) THEN
  112.     ConvertDate ('August', Month, Day, Hours, Jul) ELSE
  113.   IF (Hours > Jun) THEN
  114.     ConvertDate ('July', Month, Day, Hours, Jun) ELSE
  115.   IF (Hours > May) THEN
  116.     ConvertDate ('June', Month, Day, Hours, May) ELSE
  117.   IF (Hours > Apr) THEN
  118.     ConvertDate ('May', Month, Day, Hours, Apr) ELSE
  119.   IF (Hours > Mar) THEN
  120.     ConvertDate ('April', Month, Day, Hours, Mar) ELSE
  121.   IF (Hours > Feb) THEN
  122.     ConvertDate ('March', Month, Day, Hours, Feb) ELSE
  123.   IF (Hours > Jan) THEN
  124.     ConvertDate ('February', Month, Day, Hours, Jan)
  125.   ELSE
  126.     ConvertDate ('January', Month, Day, Hours, 0);
  127.  
  128.   WriteLn;
  129.   Write ('Star date ', ParamStr (1), ' is ');
  130.   Minutes := (Hours - Trunc (Hours));
  131.   Min := Round (Minutes * 60);
  132.   WriteLn (Month, ' ', Day:0:0, ', ', Year, ', at ', Trunc (Hours), ':', lz (Min), ' o''clock.');
  133. END.
  134.